home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / azpzip / _setup.1 / frmAbout.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-11-25  |  11.0 KB  |  260 lines

  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "About ActiveZipper Pro Demo"
  5.    ClientHeight    =   3165
  6.    ClientLeft      =   2340
  7.    ClientTop       =   1935
  8.    ClientWidth     =   5730
  9.    ClipControls    =   0   'False
  10.    Icon            =   "frmAbout.frx":0000
  11.    LinkTopic       =   "Form2"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   2184.54
  15.    ScaleMode       =   0  'User
  16.    ScaleWidth      =   5380.766
  17.    ShowInTaskbar   =   0   'False
  18.    Begin VB.CommandButton cmdOK 
  19.       Cancel          =   -1  'True
  20.       Caption         =   "OK"
  21.       Default         =   -1  'True
  22.       Height          =   345
  23.       Left            =   4245
  24.       TabIndex        =   0
  25.       Top             =   2745
  26.       Width           =   1260
  27.    End
  28.    Begin VB.Label Label2 
  29.       Caption         =   " http://www.dhc.net/~scce"
  30.       BeginProperty Font 
  31.          Name            =   "Tahoma"
  32.          Size            =   8.25
  33.          Charset         =   0
  34.          Weight          =   700
  35.          Underline       =   0   'False
  36.          Italic          =   0   'False
  37.          Strikethrough   =   0   'False
  38.       EndProperty
  39.       Height          =   255
  40.       Left            =   1560
  41.       TabIndex        =   6
  42.       Top             =   2160
  43.       Width           =   2415
  44.    End
  45.    Begin VB.Label Label1 
  46.       Caption         =   $"frmAbout.frx":0442
  47.       BeginProperty Font 
  48.          Name            =   "Tahoma"
  49.          Size            =   8.25
  50.          Charset         =   0
  51.          Weight          =   400
  52.          Underline       =   0   'False
  53.          Italic          =   0   'False
  54.          Strikethrough   =   0   'False
  55.       EndProperty
  56.       Height          =   615
  57.       Left            =   240
  58.       TabIndex        =   5
  59.       Top             =   1440
  60.       Width           =   5055
  61.    End
  62.    Begin VB.Line Line1 
  63.       BorderColor     =   &H00808080&
  64.       BorderStyle     =   6  'Inside Solid
  65.       Index           =   1
  66.       X1              =   112.686
  67.       X2              =   5337.57
  68.       Y1              =   1791.116
  69.       Y2              =   1791.116
  70.    End
  71.    Begin VB.Label lblDescription 
  72.       Caption         =   "Demo application that uses ActiveZipper Pro for compressing and decompressing files. Order this great control NOW!"
  73.       BeginProperty Font 
  74.          Name            =   "Tahoma"
  75.          Size            =   8.25
  76.          Charset         =   0
  77.          Weight          =   400
  78.          Underline       =   0   'False
  79.          Italic          =   0   'False
  80.          Strikethrough   =   0   'False
  81.       EndProperty
  82.       ForeColor       =   &H00000000&
  83.       Height          =   570
  84.       Left            =   240
  85.       TabIndex        =   1
  86.       Top             =   840
  87.       Width           =   4845
  88.    End
  89.    Begin VB.Label lblTitle 
  90.       Alignment       =   2  'Center
  91.       Caption         =   "ActiveZipper Pro Demo"
  92.       BeginProperty Font 
  93.          Name            =   "Tahoma"
  94.          Size            =   15.75
  95.          Charset         =   0
  96.          Weight          =   700
  97.          Underline       =   0   'False
  98.          Italic          =   0   'False
  99.          Strikethrough   =   0   'False
  100.       EndProperty
  101.       ForeColor       =   &H00000000&
  102.       Height          =   480
  103.       Left            =   1080
  104.       TabIndex        =   3
  105.       Top             =   120
  106.       Width           =   3645
  107.    End
  108.    Begin VB.Line Line1 
  109.       BorderColor     =   &H00FFFFFF&
  110.       BorderWidth     =   2
  111.       Index           =   0
  112.       X1              =   98.6
  113.       X2              =   5309.398
  114.       Y1              =   1801.469
  115.       Y2              =   1801.469
  116.    End
  117.    Begin VB.Label lblVersion 
  118.       Caption         =   "Version 1.4"
  119.       BeginProperty Font 
  120.          Name            =   "MS Sans Serif"
  121.          Size            =   8.25
  122.          Charset         =   0
  123.          Weight          =   700
  124.          Underline       =   0   'False
  125.          Italic          =   0   'False
  126.          Strikethrough   =   0   'False
  127.       EndProperty
  128.       Height          =   225
  129.       Left            =   2280
  130.       TabIndex        =   4
  131.       Top             =   600
  132.       Width           =   1005
  133.    End
  134.    Begin VB.Label lblDisclaimer 
  135.       Caption         =   "This program is not to be sold! Feel free to distribute it as long as nothing is modified"
  136.       BeginProperty Font 
  137.          Name            =   "Tahoma"
  138.          Size            =   8.25
  139.          Charset         =   0
  140.          Weight          =   400
  141.          Underline       =   0   'False
  142.          Italic          =   0   'False
  143.          Strikethrough   =   0   'False
  144.       EndProperty
  145.       ForeColor       =   &H00000000&
  146.       Height          =   465
  147.       Left            =   255
  148.       TabIndex        =   2
  149.       Top             =   2745
  150.       Width           =   3870
  151.    End
  152. Attribute VB_Name = "frmAbout"
  153. Attribute VB_GlobalNameSpace = False
  154. Attribute VB_Creatable = False
  155. Attribute VB_PredeclaredId = True
  156. Attribute VB_Exposed = False
  157. Option Explicit
  158. ' Reg Key Security Options...
  159. Const READ_CONTROL = &H20000
  160. Const KEY_QUERY_VALUE = &H1
  161. Const KEY_SET_VALUE = &H2
  162. Const KEY_CREATE_SUB_KEY = &H4
  163. Const KEY_ENUMERATE_SUB_KEYS = &H8
  164. Const KEY_NOTIFY = &H10
  165. Const KEY_CREATE_LINK = &H20
  166. Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
  167.                        KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
  168.                        KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  169.                      
  170. ' Reg Key ROOT Types...
  171. Const HKEY_LOCAL_MACHINE = &H80000002
  172. Const ERROR_SUCCESS = 0
  173. Const REG_SZ = 1                         ' Unicode nul terminated string
  174. Const REG_DWORD = 4                      ' 32-bit number
  175. Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
  176. Const gREGVALSYSINFOLOC = "MSINFO"
  177. Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
  178. Const gREGVALSYSINFO = "PATH"
  179. Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
  180. Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
  181. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  182. Private Sub cmdSysInfo_Click()
  183.   Call StartSysInfo
  184. End Sub
  185. Private Sub cmdOK_Click()
  186.   Unload Me
  187. End Sub
  188. Public Sub StartSysInfo()
  189.     On Error GoTo SysInfoErr
  190.     Dim rc As Long
  191.     Dim SysInfoPath As String
  192.     ' Try To Get System Info Program Path\Name From Registry...
  193.     If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  194.     ' Try To Get System Info Program Path Only From Registry...
  195.     ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  196.         ' Validate Existance Of Known 32 Bit File Version
  197.         If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
  198.             SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
  199.             
  200.         ' Error - File Can Not Be Found...
  201.         Else
  202.             GoTo SysInfoErr
  203.         End If
  204.     ' Error - Registry Entry Can Not Be Found...
  205.     Else
  206.         GoTo SysInfoErr
  207.     End If
  208.     Call Shell(SysInfoPath, vbNormalFocus)
  209.     Exit Sub
  210. SysInfoErr:
  211.     MsgBox "System Information Is Unavailable At This Time", vbOKOnly
  212. End Sub
  213. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  214.     Dim i As Long                                           ' Loop Counter
  215.     Dim rc As Long                                          ' Return Code
  216.     Dim hKey As Long                                        ' Handle To An Open Registry Key
  217.     Dim hDepth As Long                                      '
  218.     Dim KeyValType As Long                                  ' Data Type Of A Registry Key
  219.     Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
  220.     Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
  221.     '------------------------------------------------------------
  222.     ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
  223.     '------------------------------------------------------------
  224.     rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
  225.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
  226.     tmpVal = String$(1024, 0)                             ' Allocate Variable Space
  227.     KeyValSize = 1024                                       ' Mark Variable Size
  228.     '------------------------------------------------------------
  229.     ' Retrieve Registry Key Value...
  230.     '------------------------------------------------------------
  231.     rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
  232.                          KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
  233.                         
  234.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
  235.     If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 Adds Null Terminated String...
  236.         tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null Found, Extract From String
  237.     Else                                                    ' WinNT Does NOT Null Terminate String...
  238.         tmpVal = Left(tmpVal, KeyValSize)                   ' Null Not Found, Extract String Only
  239.     End If
  240.     '------------------------------------------------------------
  241.     ' Determine Key Value Type For Conversion...
  242.     '------------------------------------------------------------
  243.     Select Case KeyValType                                  ' Search Data Types...
  244.     Case REG_SZ                                             ' String Registry Key Data Type
  245.         KeyVal = tmpVal                                     ' Copy String Value
  246.     Case REG_DWORD                                          ' Double Word Registry Key Data Type
  247.         For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
  248.             KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.
  249.         Next
  250.         KeyVal = Format$("&h" + KeyVal)                     ' Convert Double Word To String
  251.     End Select
  252.     GetKeyValue = True                                      ' Return Success
  253.     rc = RegCloseKey(hKey)                                  ' Close Registry Key
  254.     Exit Function                                           ' Exit
  255. GetKeyError:      ' Cleanup After An Error Has Occured...
  256.     KeyVal = ""                                             ' Set Return Val To Empty String
  257.     GetKeyValue = False                                     ' Return Failure
  258.     rc = RegCloseKey(hKey)                                  ' Close Registry Key
  259. End Function
  260.